home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Visual Basic Source Code
/
Visual Basic Source Code.iso
/
vbsource
/
ivbsrc
/
prtinfo1.frm
< prev
next >
Wrap
Text File
|
1995-05-08
|
5KB
|
140 lines
VERSION 2.00
Begin Form Form1
Caption = "Get default printer info"
ClientHeight = 4515
ClientLeft = 3540
ClientTop = 1425
ClientWidth = 3645
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 12
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 4920
Left = 3480
LinkMode = 1 'Source
LinkTopic = "Form1"
ScaleHeight = 4515
ScaleWidth = 3645
Top = 1080
Width = 3765
WindowState = 1 'Minimized
Begin CommandButton Command2
Caption = "End"
Height = 255
Left = 2400
TabIndex = 3
Top = 3240
Width = 615
End
Begin CommandButton Command1
Caption = "Get Default Printer Info"
Height = 255
Left = 120
TabIndex = 0
Top = 3240
Width = 2295
End
Begin Label lblLPI
BorderStyle = 1 'Fixed Single
Caption = "Label1"
Height = 255
Left = 120
TabIndex = 5
Top = 1920
Width = 3375
End
Begin Label lblPort
Height = 255
Left = 240
TabIndex = 2
Top = 960
Width = 3135
End
Begin Label lblDriver
Height = 255
Left = 240
TabIndex = 1
Top = 600
Width = 3135
End
Begin Label lblPrinter
Height = 255
Left = 240
TabIndex = 4
Top = 240
Width = 3135
End
End
Declare Function GetProfileString Lib "Kernel" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Integer) As Integer
Dim PageScale As POINTAPI, PageSize As POINTAPI
Sub Command1_Click ()
lpAppName$ = "windows"
lpKeyName$ = "device"
nSize% = 81
lpRetStr$ = Space$(nSize%)
NumChars% = GetProfileString(lpAppName$, lpKeyName$, NullStr$, lpRetStr$, nSize%)
koRetStr$ = Left$(lpRetStr$, NumChars%)
CommaPos1% = InStr(1, lpRetStr$, ",")
CommaPos2% = InStr(CommaPos1% + 1, lpRetStr$, ",")
lblPrinter.Caption = "Printer: " + Left$(lpRetStr$, CommaPos1% - 1)
lblDriver.Caption = "Driver: " + Mid$(lpRetStr$, CommaPos1% + 1, CommaPos2% - CommaPos1% - 1) + ".DRV"
lblPort.Caption = "Port: " + Mid$(lpRetStr$, CommaPos2% + 1)
Result% = Escape(Printer.hDC, GETPHYSPAGESIZE, NULL, NULL, PageSize)
Orientation% = Escape(Printer.hDC, GETSETPRINTORIENT, 0, NULL, NULL)
Result% = DeviceInfo%()
Select Case Orientation%
Case 1
' lblOrientation.Caption = "Orientation: Portrait"
X_Size! = PageSize.X / PageScale.X
Y_Size! = PageSize.Y / PageScale.Y
Vertical_resolution = PageScale.Y
Case 2
' lblOrientation.Caption = "Orientation: Landscape"
Y_Size! = PageSize.X / PageScale.X
X_Size! = PageSize.Y / PageScale.Y
Vertical_resolution = PageScale.X
Case Else
' lblOrientation.Caption = ""
End Select
If X_Size > 0 And Y_Size > 0 Then
Page_Size$ = Str$(X_Size!) + " x" + Str$(Y_Size!)
' lblPaperSize.Caption = "Page Size:" + Page_Size$ + " inches"
Else
' lblPaperSize.Caption = ""
End If
'lblXSize.Caption = "X Size = " + Str$(X_Size!)
'lblYSize.Caption = "Y Size = " + Str$(Y_Size!)
'lblVerticalResolution.Caption = "Vertical Resolution = " + Str$(Vertical_resolution)
Result% = DeviceInfo%()
'lblScaleX.Caption = "Pixels X: " + Str$(PageScale.X)
'lblScaleY.Caption = "Pixels Y: " + Str$(PageScale.Y)
LPI% = Lines_Per_Inch(Int(PageScale.Y))
lblLPI.Caption = Str$(LPI%)
End Sub
Sub Command2_Click ()
End
End Sub
Function DeviceInfo () As Integer
On Error GoTo Device_Error
DeviceInfo = True
PageScale.X = GetDeviceCaps(Printer.hDC, LOGPIXELSX)
PageScale.Y = GetDeviceCaps(Printer.hDC, LOGPIXELSY)
Exit Function
Device_Error:
DeviceInfo = False
Exit Function
End Function
Function Lines_Per_Inch (Pixels_Per_Inch As Integer) As Single
Dim TextMetrix As TEXTMETRIC
Result% = GetTextMetrics(Printer.hDC, TextMetrix)
Lines_Per_Inch = Pixels_Per_Inch / (TextMetrix.tmHeight + TextMetrix.tmExternalLeading)
End Function